Disaggregated Tagging Patterns
Janette Avelar
2023-06-02
What are the top tags selected when disaggregated?
By locale
disag_locale <- full %>%
select(school_id, locale = exclusive_locale, starts_with("practices")) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(locale, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(locale) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:5)## `summarise()` has grouped output by 'locale'. You can override using the
## `.groups` argument.# urban
urban_plot <- disag_locale %>%
filter(locale == "Urban") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Urban Schools",
x = "",
y = "percentage of urban schools")
urban_plot
# suburban
suburban_plot <- disag_locale %>%
filter(locale == "Suburban") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Suburban Schools",
x = "",
y = "percentage of suburban schools")
suburban_plot
# rural
rural_plot <- disag_locale %>%
filter(locale == "Rural") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Rural Schools",
x = "",
y = "percentage of rural schools")
rural_plot
# mixed
mixed_plot <- disag_locale %>%
filter(locale == "Multiple") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools Serving\nStudents from all Geographic Locales",
x = "",
y = "percentage of mixed schools")
mixed_plot
By level
#prekindergarten
disag_pk <- full %>%
select(school_id, grades_prek, starts_with("practices")) %>%
filter(grades_prek == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Pre-Kindergarten Schools",
x = "",
y = "percentage of prek schools")
disag_pk
# elementary schools
disag_elem <- full %>%
select(school_id, grades_elementary, starts_with("practices")) %>%
filter(grades_elementary == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Elementary Schools",
x = "",
y = "percentage of elementary schools")
disag_elem
#middle schools
disag_middle <- full %>%
select(school_id, grades_middle, starts_with("practices")) %>%
filter(grades_middle == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Middle Schools",
x = "",
y = "percentage of middle schools")
disag_middle
#high schools
disag_high <- full %>%
select(school_id, grades_high, starts_with("practices")) %>%
filter(grades_high == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in High Schools",
x = "",
y = "percentage of high schools")
disag_high
By school type
disag_type <- full %>%
select(school_id, type = school_descriptor, starts_with("practices")) %>%
mutate(type = case_when(
type == 1 ~ "District",
type == 2 ~ "Charter",
type == 3 ~ "Independent"
)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(type, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(type) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:5)## `summarise()` has grouped output by 'type'. You can override using the
## `.groups` argument.#Public district schools
district_plot <- disag_type %>%
filter(type == "District") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Public District Schools",
x = "",
y = "percentage of district schools")
district_plot
#Public charter schools
charter_plot <- disag_type %>%
filter(type == "Charter") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Public Charter Schools",
x = "",
y = "percentage of charter schools")
charter_plot
#Independent schools
independent_plot <- disag_type %>%
filter(type == "Independent") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Independent (Private) Schools",
x = "",
y = "percentage of independent schools")
independent_plot
By descriptors
These plots are somewhat misleading and probably should not be displayed due to low N. For homeschools in particular, because there were only 4 schools that described themselves that way and 6 instances where they all selected the same tags, the plot displays a full 100% barchart for all 6 tags. Drawing any conclusions from this would not be a good idea, though.
For reference: homeschool N = 4
hybrid N = 21
microschool N =
school-within-school N =
*virtual N =
#homeschool
disag_homeschool <- full %>%
select(school_id, homeschool = school_descriptor_homeschool, starts_with("practices")) %>%
filter(homeschool == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because #5 had a tie with another practice -6 tags had 100% selection
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Homeschools",
subtitle = "Interpret with caution: only 4 homeschools",
x = "",
y = "percentage of homeschools")
disag_homeschool
#hybrid
disag_hybrid <- full %>%
select(school_id, hybrid = school_descriptor_hybrid, starts_with("practices")) %>%
filter(hybrid == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:4) %>% #pulled 4 because 7 tags shared #5 spot
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Hybrid Schools",
x = "",
y = "percentage of hybrid schools")
disag_hybrid
#microschool
disag_micro <- full %>%
select(school_id, micro = school_descriptor_microschool, starts_with("practices")) %>%
filter(micro == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>% #top 5 had same rate of selection (87%)
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Microschools",
subtitle = "The top 5 tags selected for microschools shared the same\nrate of selection",
x = "",
y = "percentage of microschools")
disag_micro
#school within school
disag_sws <- full %>%
select(school_id, sws = school_descriptor_sws, starts_with("practices")) %>%
filter(sws == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because tie at spot #5
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools-within-schools",
x = "",
y = "percentage of school-within-schools")
disag_sws
#virtualBy leadership team
I collapsed leadership team diversity variable in two:
predominantly White = 0-49% BIPOC leadership
predominantly BIPOC = 50% + BIPOC leadership
disag_lead <- full %>%
select(school_id, lead = leadership_diversity, starts_with("practices")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "PWI",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(lead) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:6) #tie at spot #5 for both groups## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.#predominantly white
pwled_plot <- disag_lead %>%
filter(lead == "PWI") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools led\nby Predominantly White\nLeadership Team",
x = "",
y = "percentage of schools")
pwled_plot
#BIPOC-led
bipocled_plot <- disag_lead %>%
filter(lead == "BIPOC") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools led\nby Predominantly BIPOC\nLeadership Team",
x = "",
y = "percentage of schools")
bipocled_plot
#combine plots
# combined <-
plot_grid(pwled_plot, bipocled_plot,
ncol = 2)## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
# ggsave("finding-17.png", plot = combined, path = here("final_products", "draft-findings"),
# width = 12, height = 8, units = "in")By designing for specific student groups
The plots below pull from all schools that selected
design to meet the needs of students who have been marginalized
and the follow-up question which asks them to specify which
marginalized student group they are designing for.
Which student groups?
The chart below displays the frequency with which Canopy learning environments identified specific student groups as the historically marginalized groups they’re designing their schools for.
marg_freq <- full %>%
select(starts_with("focus"), practices_design_marginalized) %>% #191/251 schools selected
select(!focus_other_student_group_text) %>%
filter(practices_design_marginalized == 1) %>%
mutate(rate = rep(1, nrow(.))) %>%
summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>%
pivot_longer(cols = starts_with("focus"),
names_to = "group",
values_to = "n") %>%
mutate(pct = n/rate,
group = case_when(
group == "focus_bipoc" ~ "BIPOC students",
group == "focus_economic_disadvantage" ~ "Economically Disadvantaged Students",
group == "focus_emergent_bilingual" ~ "Students Classified as English Learners",
group == "focus_foster" ~ "Students in the Foster Care System",
group == "focus_homeless" ~ "Students Experiencing Houselessness",
group == "focus_interrupted" ~ "Students with Interrupted Formal Education",
group == "focus_juvenile_justice" ~ "Students in the Juvenile Justice System",
group == "focus_multilingual" ~ "Multilingual Students",
group == "focus_newcomer" ~ "Newcomer and Recently Arrived Students",
group == "focus_other_student_group" ~ "Other",
group == "focus_swd" ~ "Students with Disabilities"
)) %>%
ggplot(., aes(reorder(group, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "When schools are designing for marginalized groups,\nwhich groups are they designing for?",
x = "",
y = "percentage of schools indicating designing for specific student groups") +
theme(panel.grid.major.y = element_blank())
marg_freq## Warning in labels(...): Missing tag label
ggsave("finding-18-V2.png", plot = marg_freq, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")## Warning in labels(...): Missing tag labelggsave_transcend(marg_freq, "cover_figure7", dir = here("final_products/essay-charts/cover_figures"), fig_width = 12, fig_height = 8)## Warning in labels(...): Missing tag label
## Warning in labels(...): Missing tag labelMultilingual students
disag_ml <- full %>%
select(school_id, ml = focus_multilingual, starts_with("practices")) %>%
filter(ml == 1) %>%
select(!practices_design_marginalized) %>% #dropping since all will have chosen
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because tie at spot #5
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools Designing for Multilingual students",
x = "",
y = "percentage of schools")
disag_ml
How many of the schools designing for multilingual learners also utilize dual language programming or heritage language instruction?
Of the schools indicating they were designing specifically for multilingual learners, 18% utilized dual language programming and 13% offered heritage language instruction for their multilingual students. These schools also leverage translanguaging (14%) at double the rate observed in our overall Canopy sample.
#all MLLs
ml<-
full %>%
select(practices_dual_language, practices_heritage_language, practices_translanguaging, focus_multilingual) %>%
filter(focus_multilingual == 1) %>% #111 schools focus on MLLs
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
group_by(tag) %>%
summarize(n = sum(n),
pct = paste0(round(100*(n/111)), "%"))
datatable(ml)The same pattern holds when observing schools designing specifically for students classified as English Learners, though the rates are slightly lower for dual language programming and heritage language instruction.
#ELs specifically
el <-
full %>%
select(practices_dual_language, practices_heritage_language, practices_translanguaging, focus_emergent_bilingual) %>%
filter(focus_emergent_bilingual == 1) %>% #111 schools focus on MLLs
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
group_by(tag) %>%
summarize(n = sum(n),
pct = paste0(round(100*(n/111)), "%"))
datatable(el)Comparative chart
not = data.frame(tag = c("practices_dual_language", "practices_heritage_language", "practices_translanguaging"),
n = c(31, 17, 19),
pct = c(12, 7, 8),
focus = rep("none", 3))
comp_ml <- ml %>%
mutate(focus = rep("MLL", nrow(.))) %>%
bind_rows(el) %>%
mutate(focus = replace_na(focus, "EL")) %>%
mutate(pct = str_remove_all(pct, "[:punct:]"),
pct = as.numeric(pct)) %>%
bind_rows(not) %>%
mutate(pct = pct/100) %>%
ggplot(., aes(tag, pct, fill = focus)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.x = element_blank()) +
scale_fill_manual(values = transcend_cols,
labels=c('Students Classified as English Learners', 'All Multilingual Students', 'None')) +
labs(title = "Language-Related Practices Used by Schools Focusing on Multilingual Learners",
x = "",
y = "") +
scale_x_tag() +
theme(legend.position = c(.75,.85))
# geom_text(aes(group = focus, label = scales::label_percent(accuracy = 1)(pct)),
# nudge_y = .01,
# vjust = 0,
# color = "black",
# fontface = "bold",
# size = 5,
# family = "sans")
comp_ml
ggsave("finding-19-V2.png", plot = comp_ml, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")
###version 2 - collapse ml & el focus
comp_ml2 <- ml %>%
mutate(focus = rep("MLL", nrow(.))) %>%
bind_rows(el) %>%
mutate(focus = replace_na(focus, "EL")) %>%
mutate(pct = str_remove_all(pct, "[:punct:]"),
pct = as.numeric(pct)) %>%
bind_rows(not) %>%
mutate(pct = pct/100) %>%
ggplot(., aes(tag, pct, fill = focus)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.x = element_blank()) +
scale_fill_manual(values = transcend_cols,
labels=c('Students Classified as English Learners', 'All Multilingual Students', 'None')) +
labs(title = "Language-Related Practices Used by Schools Focusing on Multilingual Learners",
x = "",
y = "") +
scale_x_tag() +
theme(legend.position = c(.75,.85))
# geom_text(aes(group = focus, label = scales::label_percent(accuracy = 1)(pct)),
# nudge_y = .01,
# vjust = 0,
# color = "black",
# fontface = "bold",
# size = 5,
# family = "sans")
comp_ml
ggsave("finding-19-V2.png", plot = comp_ml, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")Edit for MLL essay
mll_dat <- data.frame(tag = c("dual language programming", "translanguaging", "heritage language courses", "dual language programming", "translanguaging", "heritage language courses"),
percentage = c(.12, .08, .07, .15, .11, .09),
mll_focus = c("No", "No", "No", "Yes", "Yes", "Yes"))
mll_viz <- mll_dat %>%
ggplot(aes(tag, percentage, fill = mll_focus)) +
geom_bar(position = position_dodge2(reverse = TRUE), stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.x = element_blank()) +
scale_fill_manual(values = transcend_cols,
labels=c('All Canopy schools', 'Focus on Multilingual Students')) +
labs(title = "Rate of selection for language-related practices",
x = "",
y = "Percentage of Canopy schools",
fill = "School type") +
scale_x_tag() +
theme(legend.position = c(.75,.85))ggsave_transcend(mll_viz, "mll_figure1", dir = here("final_products/essay-charts/mll_figures"), fig_width = 12, fig_height = 8)## Warning in labels(...): Missing tag label
## Warning in labels(...): Missing tag labelStudents classified as English Learners
Students with interrupted formal education
Newcomer students
BIPOC students
Economically disadvantaged students
Students in the foster care system
Students experiencing houselessness
Students in the juvenile justice system
Students with disabilities
What are the top core tags selected when disaggregated?
By locale
By level
By school type
By leadership team
I collapsed leadership team diversity variable in two:
predominantly White = 0-49% BIPOC leadership
predominantly BIPOC = 50% + BIPOC leadership
core_lead <- full %>%
select(school_id, lead = leadership_diversity, starts_with("core")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "PWI",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(lead) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:6) #tie at spot #5 for one group## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.#all top 6:
#practices_pbl
#practices_culturally_responsive
#practices_restorative
#practices_sel_integrated
#practices_all_courses_designed_for_inclusion
#practices_design_marginalized
#practices_competency_education
#practices_community_partnerships
#practices_learning_paths
#practices_career_prep
#predominantly white
pwcore_plot <- core_lead %>%
filter(lead == "PWI") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Core Practices in Schools\nled by Predominantly\nWhite Leadership Team",
x = "",
y = "percentage of schools")
pwcore_plot
#BIPOC-led
bipoccore_plot <- core_lead %>%
filter(lead == "BIPOC") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Core Practices in Schools\nled by Predominantly\nBIPOC Leadership Team",
x = "",
y = "percentage of schools")
bipoccore_plot
#combine plots
# combined_core <-
plot_grid(pwcore_plot, bipoccore_plot,
ncol = 2)
# ggsave("finding-17b.png", plot = combined_core, path = here("final_products", "draft-findings"),
# width = 12, height = 8, units = "in")Alternate plot: biggest differences in tagging between PW & BIPOC leaders
labs = c("Difference = 14%", "", "Difference = 13%", "", "Difference = 12%","", "Difference = 11%","", "Difference = 10%","", "Difference = 10%","", "Difference = 9%","", "Difference = 8%","", "Difference = 8%", "", "Difference = 6%", "")
diff_core_dat <- full %>%
select(school_id, lead = leadership_diversity, starts_with("core")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "White",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = lead,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_BIPOC - pct_White), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "Leadership Team"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20)## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.diff_core <-
ggplot(diff_core_dat, aes(reorder(tag, -diff), pct, fill = `Leadership Team`)) +
geom_bar(position = "dodge", stat = "identity") +
scale_y_continuous(limits = c(0, .55), expand = c(0,0), labels = scales::percent) +
# bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>predominantly <span style = 'color: #1A4C81;'>BIPOC</span> and <span style = 'color: #EF464B;'>White</span> Leadership Teams",
subtitle = "When Canopy schools select the practices they use,they also have the option to\nselect up to 5 practices they consider central to their learning environment.\nThe comparison below displays the difference for the 5 practices schools selected.",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none") +
geom_text(aes(y = .4, label = labs),
color = transcend_grays[1],
family = "sans",
size = 4)
diff_core
ggsave("finding-17-V3.png", plot = diff_core, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")BIPOC vs. Not Dumbell plot
This is the same information as above, but displayed in a different manner.
dumbell <-
ggplot(diff_core_dat, aes(x=pct, y=fct_reorder(tag, diff))) +
geom_line(linetype= "dotted",
color = "black") +
geom_point(aes(x=pct,
y = fct_reorder(tag, diff),
color = `Leadership Team`),
size=3,
show.legend = FALSE) +
geom_text(aes(x=pct,
y=tag,
label = scales::label_percent(accuracy = 1)(pct)),
nudge_x = .03,
size = 4,
family = "sans",
color = transcend_grays[1]) +
bar_x_scale_percent +
# scale_x_continuous(limits = c(0, 1), labels = scales::percent) +
scale_color_manual(name ="",
values = c(transcend_cols[1],transcend_cols[3]),
breaks = c("BIPOC","White"),
labels=c("Predominantly BIPOC","Predominantly White")) +
labs(title = "Largest differences in core practices between<br>predominantly <span style = 'color: #1A4C81;'>BIPOC</span> and <span style = 'color: #EF464B;'>White</span> Leadership Teams",
# subtitle = "When Canopy schools select the practices they use,they also have the option to\nselect up to 5 practices they consider central to their learning environment.\nThe comparison below displays the difference for the 5 practices schools selected.",
x = "",
y = "") +
theme(plot.title = element_markdown(),
panel.grid.major = element_blank(),
legend.position = c(.75,.25)) +
scale_y_discrete(labels = label_tags(wrap = 25)) +
geom_label(aes(
x = .7,
y = 6,
label = stringr::str_wrap("When Canopy schools select the practices they use, they also have the option to select up to 5 'core practices' they consider central to their learning environment. The comparison displays the largest differences across all selected core practices.", width = 40)),
color = transcend_grays[1],
size = 5,
family = "sans")
dumbell
ggsave("finding-17-V4.png", plot = dumbell, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")What are the biggest tagging differences between “inclusive” schools and those that are not inclusive?
We should look at modeling results to draw any strong conclusions, but I’ve created a barplot below displaying the biggest tagging differences between the two groups for the core tags selected.
I defined “inclusive” as those schools that indicated they were either designing for the needs of marginalized student groups or have all courses designed for inclusion.
Analyst note I do not trust the plot below - simple difference in tagging is good to see, however, the number of schools that fell into the “inclusive” bucket (N = 217) was far bigger than those that were not (N = 34). Might be good to think more about how to account for such a difference in sample. modified 6.25.23
inclusive_diff <-
full %>%
select(school_id, inc = practices_all_courses_designed_for_inclusion, marg = practices_design_marginalized, starts_with("core")) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
select(!c(practices_all_courses_designed_for_inclusion, practices_design_marginalized)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.inclusive_diff
ggsave("finding-20.png", plot = inclusive_diff, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")Modification 1 - All tags
inclusive_dumb_dat <-
full %>%
select(school_id, inc = core_all_courses_designed_for_inclusion, marg = core_design_marginalized, starts_with("practices")) %>%
select(!c(practices_all_courses_designed_for_inclusion, practices_design_marginalized)) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20)## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.inclusive_diff3<-
ggplot(inclusive_dumb_dat, aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between schools that<br>are <span style = 'color: #1A4C81;'>designing for inclusion (N = 39)</span> and <span style = 'color: #EF464B;'>not (N = 212)</span>",
subtitle = "This plot displays the 5 core tags schools selected.",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")
inclusive_diff3
ggsave("finding-20b-V2.png", plot = inclusive_diff3, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")
#as dumbell
inclusive_dumbell <-
ggplot(inclusive_dumb_dat, aes(x=pct, y=fct_reorder(tag, -diff))) +
geom_line(linetype= "dotted",
color = "black") +
geom_point(aes(x=pct,
y = fct_reorder(tag, -diff),
color = inclusive),
size=3,
show.legend = FALSE) +
geom_text(aes(x=pct,
y=tag,
label = scales::label_percent(accuracy = 1)(pct)),
nudge_x = .03,
size = 4,
family = "sans",
color = transcend_grays[1]) +
bar_x_scale_percent +
# scale_x_continuous(limits = c(0, 1), labels = scales::percent) +
scale_color_manual(name ="",
values = c(transcend_cols[1],transcend_cols[3]),
breaks = c("inclusive","not"),
labels=c("Designing for Inclusion","Not Designing for Inclusion")) +
labs(title = "Largest differences in selected practices between schools that<br>are <span style = 'color: #1A4C81;'>focused on inclusion </span> and <span style = 'color: #EF464B;'>schools that are not </span>",
subtitle = stringr::str_wrap("Schools designing for inclusion (N = 39) were those that selected 'design to meet the needs of students who have been marginalized' or 'all courses designed for inclusion' as one of the top five core practices that are central to their approach. The remainder (N = 212) did not select either of those practices as a core practice.", width = 95),
x = "",
y = "") +
theme(plot.title = element_markdown(),
panel.grid.major = element_blank(),
legend.position = c(.75,.25)) +
scale_y_discrete(labels = label_tags(wrap = 25))
inclusive_dumbell
ggsave("finding-20b-V3.png", plot = inclusive_dumbell, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")
##for funder slides
funder_dumbell <- inclusive_dumb_dat %>%
mutate(order = case_when(
tag == "practices_mtss_academics" ~ 1,
tag == "practices_udl" ~ 2,
tag == "practices_mentoring" ~ 3,
tag == "practices_competency_framework" ~ 4,
tag == "practices_community_partnerships" ~ 5,
tag == "practices_co_leaders" ~ 6,
tag == "practices_grading_mastery" ~ 7,
tag == "practices_assessments_agency" ~ 8,
tag == "practices_teachers_leaders" ~ 9,
tag == "practices_design_thinking" ~ 10
)) %>%
ggplot(., aes(x=pct, y=fct_reorder(tag, -order))) +
geom_line(linetype= "dotted",
color = "black") +
geom_point(aes(x=pct,
y = fct_reorder(tag, -order),
color = inclusive),
size=3,
show.legend = FALSE) +
geom_text(aes(x=pct,
y=tag,
label = scales::label_percent(accuracy = 1)(pct)),
nudge_x = .03,
size = 4,
family = "sans",
color = transcend_grays[1]) +
bar_x_scale_percent +
scale_color_manual(name ="",
values = c(transcend_cols[1],transcend_cols[3]),
breaks = c("inclusive","not"),
labels=c("Designing for Inclusion","Not Designing for Inclusion")) +
labs(title = "Largest differences in selected practices between schools that<br>are <span style = 'color: #1A4C81;'>designing for inclusion (N=39)</span> and <span style = 'color: #EF464B;'>not (N=212)</span>",
subtitle = stringr::str_wrap("Schools designing for inclusion are any schools which selected the tags 'desgining for the needs of marginalized students' or 'all courses designed for inclusion' as one of the top 5 core practices central to their learning environment.", width = 95),
x = "",
y = "") +
theme(plot.title = element_markdown(),
panel.grid.major = element_blank(),
legend.position = c(.75,.25)) +
scale_y_discrete(labels = label_tags(wrap = 25))
funder_dumbell
ggsave("finding-20b-VFunder.png", plot = funder_dumbell, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")
ggsave_transcend(funder_dumbell, "cover_figure8", dir = here("final_products/essay-charts/cover_figures"), fig_width = 12, fig_height = 8)Modification for cover essay
inclusive_dumbell2 <- inclusive_dumb_dat %>%
mutate(order = case_when(
tag == "practices_mtss_academics" ~ 1,
tag == "practices_udl" ~ 2,
tag == "practices_mentoring" ~ 3,
tag == "practices_competency_framework" ~ 4,
tag == "practices_community_partnerships" ~ 5,
tag == "practices_co_leaders" ~ 6,
tag == "practices_grading_mastery" ~ 7,
tag == "practices_assessments_agency" ~ 8,
tag == "practices_teachers_leaders" ~ 9,
tag == "practices_design_thinking" ~ 10
)) %>%
ggplot(., aes(x=pct, y=fct_reorder(tag, -order))) +
geom_line(linetype= "dotted",
color = "black") +
geom_point(aes(x=pct,
y = fct_reorder(tag, -order),
color = inclusive),
size=3,
show.legend = FALSE) +
geom_text(aes(x=pct,
y=tag,
label = scales::label_percent(accuracy = 1)(pct)),
nudge_x = .03,
size = 4,
family = "sans",
color = transcend_grays[1]) +
bar_x_scale_percent +
# scale_x_continuous(limits = c(0, 1), labels = scales::percent) +
scale_color_manual(name ="",
values = c(transcend_cols[1],transcend_cols[3]),
breaks = c("inclusive","not"),
labels=c("Designing for Inclusion","Not Designing for Inclusion")) +
labs(title = "Largest differences in selected practices between schools that<br>are <span style = 'color: #1A4C81;'>focused on inclusion </span> and <span style = 'color: #EF464B;'>schools that are not </span>",
subtitle = stringr::str_wrap("Schools designing for inclusion (N = 39) were those that selected 'design to meet the needs of students who have been marginalized' or 'all courses designed for inclusion' as one of the top five core practices that are central to their approach. The remainder (N = 212) did not select either of those practices as a core practice.", width = 95),
x = "",
y = "") +
theme(plot.title = element_markdown(),
panel.grid.major = element_blank(),
legend.position = c(.75,.25)) +
scale_y_discrete(labels = label_tags(wrap = 25)) +
geom_hline(yintercept = 7.5, linetype = 5, color = "gray40") +
geom_text(x = .99, y = 7.9, color = "#1A4C81", label = "Schools designing for inclusion \nmore frequently selected these", hjust = "right") +
geom_text(x = .99, y = 1.1, color = "#EF464B", label = "Schools that did not select designing \nfor inclusion more frequently selected these", hjust = "right")
inclusive_dumbell2
ggsave_transcend(inclusive_dumbell2, "cover_figure8", dir = here("final_products/essay-charts/cover_figures"), fig_width = 12, fig_height = 8)inclusive_dumb_dat = inclusive_dumb_dat |>
mutate(
real_diff = pct[inclusive == "inclusive"] - pct[inclusive == "not"],
sign = factor(sign(real_diff)),
is_min = pct == min(pct),
.by = tag
) |>
mutate(
slope_label = ifelse(
inclusive == "not",
percent_format(accuracy = 1)(pct),
paste(percent_format(accuracy = 1)(pct), label_tags()(tag))
),
sign_label = ifelse(
sign == "1",
"More common when\nfocused on inclusion",
"Less common when\nfocused on inclusion") %>%
factor() %>% fct_rev()
)
inclusive_dumb_mids = inclusive_dumb_dat |>
summarize(
mid = mean(pct),
diff = first(diff/100),
.by = c(tag, sign, sign_label)
)
inclusive_dumbell3 = ggplot(
data = inclusive_dumb_dat %>%
mutate(tag = fct_reorder(tag, real_diff)),
aes(x = pct, y = tag)) +
geom_line(
linetype = "dotted",
color = "black"
) +
geom_point(
aes(color = inclusive),
size = 3,
show.legend = FALSE
) +
geom_text(
aes(label = scales::label_percent(accuracy = 1)(pct)),
nudge_x = ifelse(inclusive_dumb_dat$is_min, -.03, .03),
size = 4,
family = "sans",
hjust = 0.5,
color = transcend_grays[1]
) +
geom_text(data = inclusive_dumb_mids, aes(
x = mid, y = tag,
label = paste("Δ =", label_percent(accuracy = 1)(diff))
),
nudge_y = 0.2,
hjust = 0.5
) +
bar_x_scale_percent +
scale_color_manual(name ="",
values = c(transcend_cols[1],transcend_cols[3]),
breaks = c("inclusive","not"),
labels=c("Designing for Inclusion","Not Designing for Inclusion")) +
labs(title = "Largest differences in selected practices between schools that<br>are <span style = 'color: #1A4C81;'>focused on inclusion </span> and <span style = 'color: #EF464B;'>schools that are not </span>",
subtitle = stringr::str_wrap("Schools designing for inclusion (N = 39) were those that selected 'design to meet the needs of students who have been marginalized' or 'all courses designed for inclusion' as one of the top five core practices that are central to their approach. The remainder (N = 212) did not select either of those practices as a core practice.", width = 95),
x = "",
y = "") +
scale_y_discrete(labels = label_tags(wrap = 25)) +
facet_grid(rows = vars(sign_label), scales = "free_y", space = "free_y") +
theme(
plot.title = element_markdown(),
panel.grid.major = element_blank(),
panel.spacing = unit(0, "lines"),
strip.text = element_text(size = rel(0.8), hjust = 0.5),
axis.line = element_blank()
)
inclusive_dumbell3
ggsave_transcend(
inclusive_dumbell3, "cover_figure8_dumbbell_v3",
dir = here("final_products/essay-charts/cover_figures"),
fig_width = 12, fig_height = 8, write_data = FALSE
)
# slope chart
library(ggrepel)
incl_slopegraph = ggplot(inclusive_dumb_dat,
aes(x = inclusive, y = pct, color = sign, group = tag)) +
geom_point(size = 2) +
geom_line() +
geom_text_repel(
aes(label = slope_label),
nudge_x = ifelse(inclusive_dumb_dat$inclusive == "not", -.08, .1),
#direction = "y",
min.segment.length = 10
) +
labs(
x = "", y = "Schools selecting each practice (%)",
title = "Practices with the biggest difference in selection\nbetween schools focused vs not focused on inclusion",
subtitle = stringr::str_wrap("Schools designing for inclusion (N = 39) were those that selected 'design to meet the needs of students who have been marginalized' or 'all courses designed for inclusion' as one of the top five core practices that are central to their approach. The remainder (N = 212) did not select either of those practices as a core practice.", width = 85)
) +
scale_color_discrete(guide = "none") +
scale_y_continuous(guide = "none") +
scale_x_discrete(
limits = c("not", "inclusive"),
labels = c("Schools\nnot focused\non inclusion", "Schools\nfocused\non inclusion"),
expand = expansion(mult = 0, add = c(0.2, 1.8))
) +
theme(
panel.grid.major = element_blank(),
panel.border = element_blank(),
axis.line.x = element_blank()
#axis.text = element_text(size = rel(0.8)),
#axis.title = element_text(size = rel(0.8))
)
incl_slopegraph
ggsave_transcend(
incl_slopegraph, "cover_figure8_slopegraph",
dir = here("final_products/essay-charts/cover_figures"),
fig_width = 8.1, fig_height = 9
)Modification 2 - Core Tags
inclusive_diff2 <-
full %>%
select(school_id, inc = core_all_courses_designed_for_inclusion, marg = core_design_marginalized, starts_with("core")) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.inclusive_diff2
ggsave("finding-20a-V2.png", plot = inclusive_diff2, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")#model usage
model_usage<-
full %>%
select(school_id, starts_with("model")) %>%
mutate(any = case_when(
model_usage_bpl == 2 ~ 1,
model_usage_ele == 2 ~ 1,
model_usage_ib == 2 ~ 1,
model_usage_ntn == 2 ~ 1,
model_usage_oc == 2 ~ 1,
model_usage_sl == 2 ~ 1
)) %>%
select(school_id, any) %>%
unique() %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(any) %>%
summarize(sum = sum(rate, na.rm = TRUE),
pct = sum/251)